home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1997 #3 / Amiga Plus CD - 1997 - No. 03.iso / pd / programmierung / alienbreed3d2_src / amos / complight.amos / complight.amosSourceCode < prev   
AMOS Source Code  |  1997-01-31  |  5KB  |  272 lines
  1. Set Buffer 80
  2. Screen Open 7,640,24,2,Hires : Wait Vbl : Curs Off : Flash Off : Extension_12_0380 -1
  3. Palette $8,$FF0 : Paper 0 : Pen 1 : Ink 1 : Box 0,4 To 639,20
  4. Global HF,WF
  5. Dim U(128*30),T(128*30),B(128*30)
  6. 1
  7. For A=0 To 64*30 : U(A)=0 : Next 
  8. Screen Open 0,320,256,4,Lowres
  9. Curs Off : Flash Off : Cls 0
  10. Colour 1,$F00
  11. Colour 2,$FFF
  12. Colour 3,$F0
  13. Ink 2 : Box 0,16 To 319,24
  14. Ink 1
  15. Pen 2 : Paper 0
  16. Erase 12
  17. Trap Pload "ab3:includes/findsame.inc",12
  18. If Errtrap
  19.    Screen To Front 7 : Screen 7
  20.    Locate 1,1 : Print Space$(78)
  21.    Locate 1,1 : Centre "Unable to load 'ab3:includes/findsame.inc'"
  22.    Wait Key 
  23.    Edit 
  24. End If 
  25. Erase 15
  26. Reserve As Work 15,640*640+12
  27. F$=Fsel$("ab3:includes/","","Filename: ")
  28. F$=F$-".dat"
  29. F$=F$-".pal"
  30. F$=F$-".wad"
  31. F$=F$-".ptr"
  32. F$=F$-".HQN"
  33. Erase 14
  34. Erase 13
  35. Erase 11
  36. Erase 10
  37. If F$="" : Edit : End If 
  38. Trap Bload F$+".HQN",Start(15)
  39. If Errtrap
  40.    Screen To Front 7 : Screen 7
  41.    Locate 1,1 : Print Space$(78)
  42.    Locate 1,1 : Centre "Unable to load '"+F$+".HQN'"
  43.    Wait Key 
  44.    Edit 
  45. End If 
  46. NF=Deek(Start(15))
  47. WF=Deek(Start(15)+2)
  48. HF=Deek(Start(15)+4)
  49.  
  50. S=Start(15)+6
  51. For A=4 To WF*HF*NF Step 4
  52.    Loke S-6,Leek(S) : Add S,4
  53. Next 
  54. TL=WF*NF
  55. Reserve As Work 14,WF*HF*NF
  56. Reserve As Work 13,WF*NF*4
  57. Reserve As Work 11,WF*NF*4
  58. Reserve As Work 10,WF*NF*4
  59. Global S,F,D
  60. S=TL
  61. D=NF*WF*HF
  62. 'Goto NOELIM 
  63. Curs Off 
  64. Locate 0,0 : Print "Eliminating repeated strips..."
  65. NS=1
  66.  
  67. F=Start(15)+HF
  68. D=HF
  69. For X=1 To S-1
  70.  
  71.    Loke Start(12),Start(15)
  72.    Loke Start(12)+4,Start(15)+D-HF
  73.    Loke Start(12)+8,F
  74.    Doke Start(12)+12,HF
  75.    Call Start(12)+14
  76.    P=Leek(Start(12))
  77.    If P=-1
  78.       Loke Start(13)+X*4,D/HF
  79.       For A=0 To HF-4 Step 4 : Loke Start(15)+D+A,Leek(F+A) : Next : Add NS,1
  80.       Add D,HF
  81.    Else 
  82.       Loke Start(13)+X*4,P/HF
  83.    End If 
  84.    Locate 0,1
  85.    Print "Bytes Saved:";(F-Start(15))-D;"    "
  86.    H=(X*318)/S+1
  87.    Ink 1
  88.     Extension_12_04CC H,17 To H,23
  89.    H=(NS*318)/S+1
  90.    Ink 3
  91.     Extension_12_04CC H,17 To H,23
  92.    Add F,HF
  93. Next 
  94. '
  95. S=NS
  96. NOELIM:
  97. D=D+Start(14)
  98. 'Goto NOORD
  99. '
  100. U(0)=1
  101. Cls 0
  102. Ink 2 : Box 0,16 To 319,24
  103. Ink 1
  104. Pen 2 : Paper 0
  105. Locate 0,0 : Print "Sorting strips into most efficient order..."
  106. F=Start(15)
  107. For A=0 To S-1
  108.    FINDTOP[F]
  109.    T(A)=Param
  110.    FINDBOT[F]
  111.    B(A)=Param
  112.    Add F,HF
  113. Next 
  114. F=Start(15) : D=Start(14)
  115. E=Start(15)+(S-1)*HF
  116. B=HF-B(0)
  117. For A=0 To HF-1 : Poke D,Peek(F) : Add D,1 : Add F,1 : Next 
  118. '
  119. TD=0
  120. For X=1 To S-1
  121.    DIFF=200
  122.    AD=0
  123.    N=0
  124.    For J=Start(15) To E Step HF
  125.       If U(N)=0
  126.          T=Abs(T(N)-B)
  127.          If T<DIFF
  128.             DIFF=T : AD=J : NU=N
  129.          End If 
  130.          If T=0
  131.             J=E
  132.          End If 
  133.       End If 
  134.       Add N,1
  135.    Next 
  136.    U(NU)=1
  137.    For A=0 To HF-4 Step 4
  138.       Loke D+A,Leek(AD+A)
  139.    Next 
  140.    Loke Start(11)+NU*4,(D-Start(14))/HF
  141.    H=(X*318)/S+1
  142.    Ink 3
  143.     Extension_12_04CC H,17 To H,23
  144.    B=HF-B(NU)
  145.    Add D,HF
  146. Next 
  147. '
  148. NOORD:
  149. 'Goto NOPACK 
  150. Cls 0
  151. TD=0
  152. Ink 2 : Box 0,16 To 319,24
  153. Ink 1
  154. Pen 2 : Paper 0
  155. Locate 0,0 : Print "Packing Strips..."
  156. F=Start(14) : D=Start(14)+HF
  157. For A=0 To HF-1 : Poke Start(14)+A,Peek(Start(15)+A) : Next 
  158. FINDBOT[F] : Add F,HF
  159. B=Param
  160. For X=1 To S-1
  161.    FINDTOP[F]
  162.    T=Param
  163.    J=HF-B
  164.    K=Min(J,T)
  165.    TD=TD+Abs(J-T)
  166.    D=D-K
  167.    FINDBOT[F] : B=Param
  168.    For A=0 To HF-1 : Poke D+A,Peek(F+A) : Next 
  169.    Loke Start(10)+X*4,D-Start(14)
  170.    Add D,HF
  171.    Add F,HF
  172.    Locate 0,1
  173.    Print "Bytes Saved:";(F-D);"    "
  174.    H=(X*318)/S+1
  175.    Ink 1
  176.     Extension_12_04CC H,17 To H,23
  177.    H=(((D-Start(14))/HF)*318)/S+1
  178.    Ink 3
  179.     Extension_12_04CC H,17 To H,23
  180.    H=((TD/HF)*318)/S+1
  181.    Ink 0
  182.     Extension_12_04CC H,17 To H,23
  183. Next 
  184. '
  185. NOPACK:
  186. MD=D-Start(14)
  187. '
  188. For A=0 To TL-1
  189.    P=Leek(Start(13)+A*4)
  190.    P=Leek(Start(11)+P*4)
  191.    P=Leek(Start(10)+P*4)
  192.    Loke Start(13)+A*4,P
  193. Next 
  194. '
  195. 'LF=MD 
  196. 'LF=LF/3 
  197. 'LF=LF+64
  198. '
  199. 'For A=0 To TL-1 
  200. '   P=Leek(Start(13)+A*4)
  201. '   If P<=LF and(P+HF)>LF
  202. '      FT=P
  203. '   End If 
  204. '   If(P<=(LF+LF)) and((P+HF)>(LF+LF)) 
  205. '      ST=P
  206. '   End If 
  207. 'Next  
  208. 'D=Start(15) : F=Start(14) 
  209. 'For A=0 To MD 
  210. 'Poke Start(15)+A,0
  211. 'Next  
  212. 'For A=0 To FT+HF-1
  213. '   Doke D,Peek(F) : Add D,2 : Add F,1 
  214. 'Next  
  215. 'F=F-HF
  216. 'BIGD=D
  217. 'D=Start(15) 
  218. 'For A=FT To ST+HF-1 
  219. '   C=Deek(D)
  220. '   C=C+(Peek(F)*32) 
  221. '   Doke D,C 
  222. '   Add D,2 : Add F,1
  223. 'Next  
  224. 'BIGD=Max(BIGD,D)
  225. 'F=F-HF
  226. 'D=Start(15) 
  227. 'For A=ST To MD+HF-1 
  228. '   C=Deek(D)
  229. '   C=C+(Peek(F)*32*32)
  230. '   Doke D,C 
  231. '   Add D,2 : Add F,1
  232. 'Next  
  233. 'BIGD=Max(BIGD,D)
  234. 'For A=0 To TL-1 
  235. '   P=Leek(Start(13)+A*4)
  236. '   If P>=ST 
  237. '      P=P-ST
  238. '      P=P*2 
  239. '      P=P+$2000000
  240. '   Else 
  241. '      If P>=FT
  242. '         P=P-FT 
  243. '         P=P*2
  244. '         P=P+$1000000 
  245. '      Else  
  246. '         P=P*2
  247. '      End If  
  248. '   End If 
  249. '   Loke(Start(13)+A*4),P
  250. 'Next  
  251. '    
  252. Locate 0,4
  253. Print "Old File Size:";TL*HF
  254. ZLF=(D-Start(14))+4*TL
  255. Print "New File Size:";ZLF
  256. Print "Memory saving:";(TL*HF)-ZLF;" = ";((TL*HF-ZLF)*100)/(TL*HF);"%"
  257. Bsave F$+".wad",Start(14) To D
  258. Bsave F$+".ptr",Start(13) To Start(13)+TL*4
  259. Wait Key 
  260. Goto 1
  261. '
  262. Procedure FINDBOT[A]
  263.    Z=HF
  264.    For L=HF-1 To 0 Step -1 : If Peek(A+L)=0 Then Z=L Else L=-10
  265.    Next 
  266. End Proc[Z]
  267. '
  268. Procedure FINDTOP[A]
  269.    Z=0
  270.    For L=0 To HF : If Peek(A+L)=0 Then Z=L+1 Else L=1000
  271.    Next 
  272. End Proc[Z]